perm filename GAME.LSP[206,JMC] blob
sn#075781 filedate 1973-12-04 generic text, type T, neo UTF8
(DEFPROP GAMEFNS
(GAMEFNS VALMAX
VALMIN
LINEMAX
LINEMIN
TREEMAX
TREEMIN
RECTIFY
COMMONTAIL
COMMONHEAD)
VALUE)
(DEFPROP VALMAX
(LAMBDA(U ALPHA BETA)
(COND ((NULL U) ALPHA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA))
(VALMAX (CDR U) ALPHA BETA))
((LESSP S BETA) (VALMAX (CDR U) S BETA))
(T BETA)))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
(T (VALMIN (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)
(DEFPROP VALMIN
(LAMBDA(U ALPHA BETA)
(COND ((NULL U) BETA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA)) ALPHA)
((LESSP S BETA) (VALMIN (CDR U) ALPHA S))
(T (VALMIN (CDR U) ALPHA BETA))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
(T (VALMAX (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)
(DEFPROP LINEMAX
(LAMBDA(U LINE ALPHA BETA)
(COND ((NULL U) (CONS ALPHA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA))
(LINEMAX (CDR U) LINE ALPHA BETA))
((LESSP (CAR S) BETA)
(LINEMAX (CDR U)
(CONS (EXT (CAR U)) (CDR S))
(CAR S)
BETA))
(T (CONS BETA LINE))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA)
(LIST (IMVAL (CAR U))))
(T
(LINEMIN (SUCCESSORS (CAR U))
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP LINEMIN
(LAMBDA(U LINE ALPHA BETA)
(COND ((NULL U) (CONS BETA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
((LESSP (CAR S) BETA)
(LINEMIN (CDR U)
(CONS (EXT (CAR U)) (CDR S))
ALPHA
(CAR S)))
(T (LINEMIN (CDR U) LINE ALPHA BETA))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA)
(LIST (IMVAL (CAR U))))
(T
(LINEMAX (SUCCESSORS (CAR U))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP TREEMAX
(LAMBDA(U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST ALPHA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(TREEMAX (CDR U)
TRMAX
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
ALPHA
BETA))
((LESSP (CAR S) BETA)
(TREEMAX (CDR U)
(CONS (EXT (CAR U)) (CADR S))
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
(CAR S)
BETA))
(T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
(T
(TREEMIN (SUCCESSORS (CAR U))
NIL
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP TREEMIN
(LAMBDA(U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST BETA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
((LESSP (CAR S) BETA)
(TREEMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
(CONS (EXT (CAR U)) (CADDR S))
ALPHA
(CAR S)))
(T
(TREEMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
TRMIN
ALPHA
BETA))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
(T
(TREEMAX (SUCCESSORS (CAR U))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
NIL
ALPHA
BETA)))))))
EXPR)
(DEFPROP RECTIFY
(LAMBDA(P)
(PROG (Z Q)
(SETQ Q (COMMONTAIL P P1))
L1 (COND ((EQUAL Q P1) (GO L2)))
(REVERT)
(GO L1)
L2 (SETQ Z (LISTSUBT P P1))
L3 (COND ((NULL Z) (RETURN P)))
(UPDATE (CAR Z))
(SETQ Z (CDR Z))
(GO L3)))
EXPR)
(DEFPROP COMMONTAIL
(LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)
(DEFPROP COMMONHEAD
(LAMBDA(U V)
(COND ((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)